{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

{-# HLINT ignore "Use lambda-case" #-}
module Tools.DynamicLogic where

import Data.Aeson as A
import qualified Data.Aeson.KeyMap as KM
import Data.List (nub)
import Kernel.Prelude
import Kernel.Randomizer
import qualified Kernel.Storage.Hedis as Hedis
import Kernel.Types.Common
import Kernel.Types.Error
import Kernel.Types.Id
import Kernel.Types.TimeBound
import Kernel.Utils.Common
import Lib.Yudhishthira.Storage.Beam.BeamFlow
import qualified Lib.Yudhishthira.Storage.CachedQueries.AppDynamicLogicElement as DALE
import qualified Lib.Yudhishthira.Storage.CachedQueries.AppDynamicLogicRollout as DALR
import qualified Lib.Yudhishthira.Storage.CachedQueries.TimeBoundConfig as CTBC
import qualified Lib.Yudhishthira.Tools.Utils as LYTU
import Lib.Yudhishthira.Types
import Lib.Yudhishthira.Types.AppDynamicLogicRollout

findOneConfig :: forall a m r. (FromJSON a, ToJSON a, BeamFlow m r) => Id MerchantOperatingCity -> LogicDomain -> Maybe [ConfigVersionMap] -> Maybe Value -> (m (Maybe a)) -> m (Maybe a)
findOneConfig merchantOpCityId cfgDomain mbConfigInExperimentVersions extraDimensions getConfigFromDBFunc = do
  currentTime <- getCurrentTime
  let extraDimensionsWithTime = fmap (\dims -> case dims of A.Object obj -> A.Object (KM.insert "currentTime" (toJSON currentTime) obj); _ -> A.Object (KM.fromList [("currentTime", toJSON currentTime)])) extraDimensions
  mbVersion <- getConfigVersion merchantOpCityId mbConfigInExperimentVersions cfgDomain
  cachedConfig :: Maybe a <- Hedis.withCrossAppRedis $ Hedis.safeHGet (makeRedisHashKeyForConfig merchantOpCityId cfgDomain) (makeCacheKeyForConfig mbVersion)
  case cachedConfig of
    Just cfg -> return $ Just cfg
    Nothing -> fetchAndCacheConfig mbVersion extraDimensionsWithTime
  where
    fetchAndCacheConfig mbVersion extraDimensionsWithTime = do
      allLogics <- getConfigLogic merchantOpCityId mbVersion cfgDomain
      mbConfig <- getConfigFromDBFunc
      config <- maybe (return Nothing) (\cfg -> Just <$> processConfig allLogics mbVersion extraDimensionsWithTime cfg) mbConfig
      cacheConfig (makeRedisHashKeyForConfig merchantOpCityId cfgDomain) (makeCacheKeyForConfig mbVersion) config
      return config

findAllConfigs :: forall a m r. (FromJSON a, ToJSON a, BeamFlow m r) => Id MerchantOperatingCity -> LogicDomain -> Maybe [ConfigVersionMap] -> Maybe Value -> m [a] -> m [a]
findAllConfigs merchantOpCityId cfgDomain mbConfigInExperimentVersions extraDimensions getConfigFromDBFunc = do
  currentTime <- getCurrentTime
  let extraDimensionsWithTime = fmap (\dims -> case dims of A.Object obj -> A.Object (KM.insert "currentTime" (toJSON currentTime) obj); _ -> A.Object (KM.fromList [("currentTime", toJSON currentTime)])) extraDimensions
  mbVersion <- getConfigVersion merchantOpCityId mbConfigInExperimentVersions cfgDomain
  cachedConfig :: Maybe [a] <- Hedis.withCrossAppRedis $ Hedis.safeHGet (makeRedisHashKeyForConfig merchantOpCityId cfgDomain) (makeCacheKeyForConfig mbVersion)
  case cachedConfig of
    Just cfgs -> return cfgs
    Nothing -> fetchAndCacheConfig mbVersion extraDimensionsWithTime
  where
    fetchAndCacheConfig mbVersion extraDimensionsWithTime = do
      allLogics <- getConfigLogic merchantOpCityId mbVersion cfgDomain
      listConfig <- getConfigFromDBFunc
      allConfigs <- mapM (processConfig allLogics mbVersion extraDimensionsWithTime) listConfig
      cacheConfig (makeRedisHashKeyForConfig merchantOpCityId cfgDomain) (makeCacheKeyForConfig mbVersion) allConfigs
      return allConfigs

findOneConfigWithCacheKey :: forall a m r. (FromJSON a, ToJSON a, BeamFlow m r) => Id MerchantOperatingCity -> LogicDomain -> Maybe [ConfigVersionMap] -> Maybe Value -> m (Maybe a) -> Text -> m (Maybe a)
findOneConfigWithCacheKey merchantOpCityId cfgDomain mbConfigInExperimentVersions extraDimensions getConfigFromDBFunc cacheKey = do
  currentTime <- getCurrentTime
  let extraDimensionsWithTime = fmap (\dims -> case dims of A.Object obj -> A.Object (KM.insert "currentTime" (toJSON currentTime) obj); _ -> A.Object (KM.fromList [("currentTime", toJSON currentTime)])) extraDimensions
  mbVersion <- getConfigVersion merchantOpCityId mbConfigInExperimentVersions cfgDomain
  cachedConfig <- Hedis.withCrossAppRedis $ Hedis.safeHGet (makeRedisHashKeyForConfig merchantOpCityId cfgDomain) (makeCacheKeyForConfigWithPrefix cacheKey mbVersion)
  case cachedConfig of
    Just cfg -> return $ Just cfg
    Nothing -> fetchAndCacheConfig mbVersion extraDimensionsWithTime
  where
    fetchAndCacheConfig mbVersion extraDimensionsWithTime = do
      allLogics <- getConfigLogic merchantOpCityId mbVersion cfgDomain
      mbConfig <- getConfigFromDBFunc
      config <- maybe (return Nothing) (\cfg -> Just <$> processConfig allLogics mbVersion extraDimensionsWithTime cfg) mbConfig
      cacheConfig (makeRedisHashKeyForConfig merchantOpCityId cfgDomain) (makeCacheKeyForConfigWithPrefix cacheKey mbVersion) config
      return config

findAllConfigsWithCacheKey :: forall a m r. (FromJSON a, ToJSON a, BeamFlow m r) => Id MerchantOperatingCity -> LogicDomain -> Maybe [ConfigVersionMap] -> Maybe Value -> m [a] -> Text -> m [a]
findAllConfigsWithCacheKey merchantOpCityId cfgDomain mbConfigInExperimentVersions extraDimensions getConfigFromDBFunc cacheKey = do
  currentTime <- getCurrentTime
  let extraDimensionsWithTime = fmap (\dims -> case dims of A.Object obj -> A.Object (KM.insert "currentTime" (toJSON currentTime) obj); _ -> A.Object (KM.fromList [("currentTime", toJSON currentTime)])) extraDimensions
  mbVersion <- getConfigVersion merchantOpCityId mbConfigInExperimentVersions cfgDomain
  cachedConfig :: Maybe [a] <- Hedis.withCrossAppRedis $ Hedis.safeHGet (makeRedisHashKeyForConfig merchantOpCityId cfgDomain) (makeCacheKeyForConfigWithPrefix cacheKey mbVersion)
  logDebug $ "cachedConfig: " <> (show $ isNothing cachedConfig)
  case cachedConfig of
    Just cfgs -> return cfgs
    Nothing -> fetchAndCacheConfig mbVersion extraDimensionsWithTime
  where
    fetchAndCacheConfig mbVersion extraDimensionsWithTime = do
      allLogics <- getConfigLogic merchantOpCityId mbVersion cfgDomain
      listConfig <- getConfigFromDBFunc
      allConfigs <- mapM (processConfig allLogics mbVersion extraDimensionsWithTime) listConfig
      cacheConfig (makeRedisHashKeyForConfig merchantOpCityId cfgDomain) (makeCacheKeyForConfigWithPrefix cacheKey mbVersion) allConfigs
      return allConfigs

processConfig :: forall a m r. (FromJSON a, ToJSON a, BeamFlow m r) => [A.Value] -> Maybe Int -> Maybe Value -> a -> m a
processConfig allLogics mbVersion extraDimensions cfg = do
  let configWrapper = Config cfg extraDimensions 0
  response <- withTryCatch "runLogics:processConfig" $ LYTU.runLogics allLogics configWrapper
  case response of
    Left e -> do
      logError $ "Error in running logics for rider config for version: " <> show mbVersion <> " and error: " <> show e
      return cfg
    Right resp -> do
      case (fromJSON (resp.result) :: Result (Config a)) of
        A.Success result -> do
          return result.config
        A.Error err -> do
          logError $ "Error in running logics for rider config: " <> show err
          return cfg

getConfigVersion ::
  BeamFlow m r =>
  Id MerchantOperatingCity ->
  Maybe [ConfigVersionMap] ->
  LogicDomain ->
  m (Maybe Int)
getConfigVersion merchantOpCityId mbConfigInExperimentVersions domain = do
  case mbConfigInExperimentVersions of
    Nothing -> selectVersionForUnboundedConfigs merchantOpCityId domain Nothing
    Just configInExperimentVersions -> do
      let configVersionMap = find (\a -> a.config == domain) configInExperimentVersions
      return $ configVersionMap <&> (.version)

getConfigLogic ::
  BeamFlow m r =>
  Id MerchantOperatingCity ->
  Maybe Int ->
  LogicDomain ->
  m [A.Value]
getConfigLogic merchantOpCityId mbVersion configDomain = do
  mbBaseRollout <- DALR.findBaseRolloutByMerchantOpCityAndDomain (cast merchantOpCityId) configDomain
  baseLogics <- maybe (return []) (\rollout -> DALE.findByDomainAndVersion configDomain rollout.version) mbBaseRollout
  when (null baseLogics) $ logWarning $ "Base logic not found for merchantOpCityId: " <> show merchantOpCityId <> " and configDomain: " <> show configDomain
  case (mbVersion, mbBaseRollout) of
    (Just version, Just rollout) | version == rollout.version -> return $ baseLogics <&> (.logic)
    (Just version, _) -> do
      experimentLogic <- DALE.findByDomainAndVersion configDomain version
      when (null experimentLogic) $ logError $ "Experiment logic not found for merchantOpCityId: " <> show merchantOpCityId <> " and configDomain: " <> show configDomain <> " and version: " <> show version
      let logics = baseLogics <> experimentLogic
      return $ logics <&> (.logic)
    (Nothing, _) -> return $ baseLogics <&> (.logic)

getAppDynamicLogic ::
  BeamFlow m r =>
  Id MerchantOperatingCity ->
  LogicDomain ->
  UTCTime ->
  Maybe Int ->
  Maybe Int ->
  m ([A.Value], Maybe Int)
getAppDynamicLogic merchantOpCityId domain localTime mbVersion mbToss = do
  mbFinalVersion <- pure mbVersion |<|>| selectAppDynamicLogicVersion merchantOpCityId domain localTime mbToss
  case mbFinalVersion of
    Just version -> do
      logics <- DALE.findByDomainAndVersion domain version
      when (null logics) $ logError $ "No dynamic logic found for merchantOpCityId: " <> show merchantOpCityId <> " and domain: " <> show domain <> " and version: " <> show version
      return (logics <&> (.logic), Just version)
    Nothing -> do
      logWarning $ "Missing Version, No dynamic logic found for merchantOpCityId: " <> show merchantOpCityId <> " and domain: " <> show domain
      return ([], Nothing)

selectVersionForUnboundedConfigs ::
  BeamFlow m r =>
  Id MerchantOperatingCity ->
  LogicDomain ->
  Maybe Int ->
  m (Maybe Int)
selectVersionForUnboundedConfigs merchantOpCityId domain mbToss = do
  mbConfigs <- DALR.findByMerchantOpCityAndDomain (cast merchantOpCityId) domain
  configs <- if null mbConfigs then DALR.findByMerchantOpCityAndDomain (Id "default") domain else return mbConfigs
  let applicapleConfigs = filter (\cfg -> cfg.timeBounds == "Unbounded") configs
  mbSelectedConfig <- chooseLogic applicapleConfigs mbToss
  return $ mbSelectedConfig <&> (.version)

isExperimentRunning :: BeamFlow m r => Id MerchantOperatingCity -> LogicDomain -> m Bool
isExperimentRunning merchantOpCityId domain = do
  mbConfigs <- DALR.findByMerchantOpCityAndDomain (cast merchantOpCityId) domain
  return $ any (\cfg -> cfg.percentageRollout /= 100 && cfg.percentageRollout /= 0) mbConfigs

selectAppDynamicLogicVersion ::
  BeamFlow m r =>
  Id MerchantOperatingCity ->
  LogicDomain ->
  UTCTime ->
  Maybe Int ->
  m (Maybe Int)
selectAppDynamicLogicVersion merchantOpCityId domain localTime mbToss = do
  mbConfigs <- DALR.findByMerchantOpCityAndDomain (cast merchantOpCityId) domain
  configs <- if null mbConfigs then DALR.findByMerchantOpCityAndDomain (Id "default") domain else return mbConfigs
  allTimeBoundConfigs <- CTBC.findByCityAndDomain (cast merchantOpCityId) domain
  let boundedTimeBoundConfigs = findBoundedDomain (filter (\cfg -> cfg.timeBounds /= Unbounded) allTimeBoundConfigs) localTime
  let applicapleConfigs =
        case boundedTimeBoundConfigs of -- if not bounded config found, return all configs with Unbounded timeBounds
          [] -> unboundedConfigs configs
          (x : _) -> do
            let boundedConfigs = filter (\cfg -> cfg.timeBounds == x.name) configs
            if null boundedConfigs
              then unboundedConfigs configs
              else boundedConfigs
  mbSelectedConfig <- chooseLogic applicapleConfigs mbToss
  return $ mbSelectedConfig <&> (.version)
  where
    unboundedConfigs = filter (\cfg -> cfg.timeBounds == "Unbounded")

cumulativeRollout :: [AppDynamicLogicRollout] -> [(AppDynamicLogicRollout, Int)]
cumulativeRollout logics = scanl1 addPercentages $ zip logics (map (.percentageRollout) logics)
  where
    addPercentages (_, p1) (logic2, p2) = (logic2, p1 + p2)

chooseLogic :: MonadFlow m => [AppDynamicLogicRollout] -> Maybe Int -> m (Maybe AppDynamicLogicRollout)
chooseLogic logics mbToss = do
  let cumulative = cumulativeRollout logics
  toss <- maybe (getRandomInRange (1, 100 :: Int)) pure mbToss
  return $ findLogic toss cumulative

-- Function to find the logic corresponding to the random number
findLogic :: Int -> [(AppDynamicLogicRollout, Int)] -> Maybe AppDynamicLogicRollout
findLogic _ [] = Nothing
findLogic randVal ((logic, cumPercent) : xs)
  | randVal <= cumPercent = Just logic
  | otherwise = findLogic randVal xs

getConfigVersionMapForStickiness ::
  BeamFlow m r =>
  Id MerchantOperatingCity ->
  m [ConfigVersionMap]
getConfigVersionMapForStickiness merchantOpCityId = do
  allConfigsRollouts <- DALR.fetchAllConfigsByMerchantOpCityId merchantOpCityId -- TODO: change to fetchAllBaseConfigsByMerchantOpCityId and cache it
  let configsInExperiment :: [LogicDomain] = nub $ map (.domain) $ filter (\rollout -> rollout.percentageRollout /= 100 && rollout.isBaseVersion == Just True) allConfigsRollouts
  mbConfigVersionMap <- mapM getVersion configsInExperiment
  let configVersionMap :: [ConfigVersionMap] = catMaybes mbConfigVersionMap
  return configVersionMap
  where
    getVersion domain = do
      mbVersion <- selectVersionForUnboundedConfigs merchantOpCityId domain Nothing
      case (mbVersion, domain) of
        (Just version, RIDER_CONFIG _) -> return $ Just $ ConfigVersionMap domain version
        (Just version, DRIVER_CONFIG _) -> return $ Just $ ConfigVersionMap domain version
        _ -> return Nothing

cacheConfig :: (ToJSON a, CacheFlow m r) => Text -> Text -> a -> m ()
cacheConfig redisHashKey configKey config = do
  expTime <- fromIntegral <$> asks (.cacheConfig.configsExpTime)
  Hedis.withCrossAppRedis $ Hedis.hSetExp redisHashKey configKey config expTime

makeRedisHashKeyForConfig :: Id MerchantOperatingCity -> LogicDomain -> Text
makeRedisHashKeyForConfig cityId configDomain = "CacheHash:" <> show configDomain <> "-MerchantOperatingCityId:" <> cityId.getId

makeCacheKeyForConfig :: Maybe Int -> Text
makeCacheKeyForConfig mbVersion = "V:" <> show mbVersion

makeCacheKeyForConfigWithPrefix :: Text -> Maybe Int -> Text
makeCacheKeyForConfigWithPrefix prefix mbVersion = prefix <> "-V:" <> show mbVersion

clearConfigCache :: BeamFlow m r => Id MerchantOperatingCity -> LogicDomain -> Maybe Int -> m ()
clearConfigCache merchanOperatingCityId configDomain mbVersion = do
  Hedis.withCrossAppRedis $
    case mbVersion of
      Nothing -> do
        rollouts <- DALR.findByMerchantOpCityAndDomain merchanOperatingCityId configDomain
        let allKeys = makeCacheKeyForConfig Nothing : map (\r -> makeCacheKeyForConfig (Just r.version)) rollouts
        Hedis.hDel (makeRedisHashKeyForConfig merchanOperatingCityId configDomain) allKeys
      Just version -> Hedis.hDel (makeRedisHashKeyForConfig merchanOperatingCityId configDomain) [makeCacheKeyForConfig (Just version)]

clearConfigCacheWithPrefix :: BeamFlow m r => Text -> Id MerchantOperatingCity -> LogicDomain -> Maybe Int -> m ()
clearConfigCacheWithPrefix prefix merchanOperatingCityId configDomain mbVersion = do
  Hedis.withCrossAppRedis $
    case mbVersion of
      Nothing -> do
        rollouts <- DALR.findByMerchantOpCityAndDomain merchanOperatingCityId configDomain
        let allKeys = makeCacheKeyForConfigWithPrefix prefix Nothing : map (\r -> makeCacheKeyForConfigWithPrefix prefix (Just r.version)) rollouts
        Hedis.hDel (makeRedisHashKeyForConfig merchanOperatingCityId configDomain) allKeys
      Just version -> Hedis.hDel (makeRedisHashKeyForConfig merchanOperatingCityId configDomain) [makeCacheKeyForConfigWithPrefix prefix (Just version)]

deleteConfigHashKey :: BeamFlow m r => Id MerchantOperatingCity -> LogicDomain -> m ()
deleteConfigHashKey merchantOpCityId configDomain = do
  Hedis.withCrossAppRedis $ Hedis.del (makeRedisHashKeyForConfig merchantOpCityId configDomain)

findOneUiConfig :: forall a m r. (FromJSON a, ToJSON a, BeamFlow m r, HasField "config" a Value) => Id MerchantOperatingCity -> LogicDomain -> Maybe [ConfigVersionMap] -> Maybe Value -> m (Maybe a) -> Bool -> m (Maybe (a, Int))
findOneUiConfig merchantOpCityId cfgDomain mbConfigInExperimentVersions extraDimensions getConfigFromDBFunc isBaseLogic = do
  currentTime <- getCurrentTime
  let extraDimensionsWithTime = fmap (\dims -> case dims of A.Object obj -> A.Object (KM.insert "currentTime" (toJSON currentTime) obj); _ -> A.Object (KM.fromList [("currentTime", toJSON currentTime)])) extraDimensions
  mbVersion <-
    if isBaseLogic
      then do
        mbBaseRollout <- DALR.findBaseRolloutByMerchantOpCityAndDomain merchantOpCityId cfgDomain >>= fromMaybeM (InvalidRequest "Base Rollout not found")
        return $ Just mbBaseRollout.version
      else getConfigVersion merchantOpCityId mbConfigInExperimentVersions cfgDomain
  cachedConfig :: Maybe a <- Hedis.withCrossAppRedis $ Hedis.safeHGet (makeRedisHashKeyForConfig merchantOpCityId cfgDomain) (makeCacheKeyForConfig mbVersion)
  case (cachedConfig, mbVersion) of
    (Just cfg, Just version) -> return $ Just (cfg, version)
    (Nothing, Just _) -> fetchAndCacheConfig mbVersion extraDimensionsWithTime
    _ -> return Nothing
  where
    fetchAndCacheConfig mbVersion extraDimensionsWithTime = do
      allLogics <-
        if isBaseLogic
          then do
            getConfigLogic merchantOpCityId Nothing cfgDomain
          else getConfigLogic merchantOpCityId mbVersion cfgDomain
      mbConfig :: Maybe a <- getConfigFromDBFunc
      config :: Maybe Value <- maybe (return Nothing) (\cfg -> Just <$> processConfig allLogics mbVersion extraDimensionsWithTime (getField @"config" cfg :: Value)) mbConfig
      -- apply the updated json to the old config and return the updated config
      finalConfig :: Maybe a <- case (mbConfig, config) of
        (Just oldCfg, Just newValue) -> do
          return $ Just $ setField @"config" oldCfg newValue
        _ -> return Nothing
      cacheConfig (makeRedisHashKeyForConfig merchantOpCityId cfgDomain) (makeCacheKeyForConfig mbVersion) finalConfig
      return $ (,) <$> finalConfig <*> mbVersion
